exception Requete_en_cours
exception Pas_de_requete
type reponse =
  | Accepte
  | Refuse
  | Erreur
type 'carte partie =
    {
      mutable joueur: 'carte Joueur.joueur;
      mutable mon_jeu: 'carte list;
      mutable chien: 'carte list;
      mutable tapis: 'carte list; (* On ne met pas la fausse excuse *)
      (* Le tapis est dans le mauvais sens : dernière carte jouée d'abord. *)
      mutable joueur_ouverture: int;
      mutable plis_joues: int;
      mutable carte_a_jouer: 'carte option;
      mutable chaine_reponse: (reponse -> unit) list;
    }
let est_connecte j = Joueur.est_connecte j.joueur
let string_of_joueur j = Joueur.string_of_joueur j.joueur
let joueurs_disponibles j = Joueur.joueurs_disponibles j.joueur
let mes_adversaires j = Joueur.mes_adversaires j.joueur
let en_jeu j = Joueur.en_jeu j.joueur
let mon_numero j = Joueur.mon_numero j.joueur
let enchere_de j = Joueur.enchere_de j.joueur
let preneur j = Joueur.preneur j.joueur
let carte_appelee j = Joueur.carte_appelee j.joueur
let ecart_connu j = Joueur.ecart_connu j.joueur
let mon_jeu j = j.mon_jeu
let chien j = j.chien
let repartition_cartes carte_sup_large excuse fausse_excuse j =
  let mapi f liste =
    let rec aux i = function
      | [] -> []
      | hd :: tl -> (f i hd) :: (aux (i + 1) tl)
    in
    aux 0 liste
  in
  let tapis = mapi (fun i carte -> ((i + j.joueur_ouverture) mod 5, 
				    carte)) (List.rev j.tapis) in
  let emporte_sur (joueur, carte) (i, c) =
    if carte_sup_large carte c then (joueur, carte)
    else (i, c)
  in
  match tapis with
  | [] -> []
  | a :: b ->
     let (maitre, carte_maitresse) = List.fold_left (emporte_sur)
						    a b in
     let llistes =
       List.map
	 (fun (poseur, carte) ->
	  if carte = excuse then
	    if j.plis_joues >= 14 then (*excuse prise*)
	      [(poseur, excuse, maitre) ; (poseur, fausse_excuse, maitre)]
	    else
	      [(poseur, excuse, poseur) ; (poseur, fausse_excuse, maitre)]
	  else
	    [(poseur, carte, maitre)]) tapis
     in
     List.fold_right (@) llistes []
let pli_termine j =
  List.length (j.tapis) = 5
let joueur_maitre carte_sup_large j =
  let mapi f liste =
    let rec aux i = function
      | [] -> []
      | hd :: tl -> (f i hd) :: (aux (i + 1) tl)
    in
    aux 0 liste
  in
  let tapis = mapi (fun i carte -> ((i + j.joueur_ouverture) mod 5, 
				    carte)) (List.rev j.tapis) in
  let emporte_sur (joueur, carte) (i, c) =
    if carte_sup_large carte c then 
      (joueur, carte)
    else 
      (i, c)
  in
  match tapis with
  | [] -> None
  | a :: b ->
     Some (fst (List.fold_left (emporte_sur) a b))
let nombre_plis_joues j = j.plis_joues		     
let couleur_demandee couleur_of_carte excuse j =
  match List.rev j.tapis with
  | [] ->
     None
  | [x] when x = excuse ->
     None
  | a :: b :: _ when a = excuse ->
     Some (couleur_of_carte b)
  | x :: _ ->
     Some (couleur_of_carte x)
let joueur_ouverture j =
  j.joueur_ouverture
let requete_en_cours j =
  if Joueur.requete_en_cours j.joueur then true
  else 
    match j.carte_a_jouer with
    | None -> false
    | Some c -> 
       (* let () =  *)
       (* 	 Printf.printf  *)
       (* 	   "Attention : %s est en train de demander à jouer une carte.\n" *)
       (* 	   (string_of_joueur j) *)
       (* in *)
       true
let doit_priser j =
  j.mon_jeu <> []
  && (Joueur.doit_priser j.joueur)
let enchere_maximale j = Joueur.enchere_maximale j.joueur
let doit_appeler j = Joueur.doit_appeler j.joueur
let doit_ecarter j = (j.chien <> []) && (Joueur.doit_ecarter j.joueur)
let devant_jouer j =
  (j.joueur_ouverture + List.length j.tapis) mod 5
let doit_jouer j =
  let partie_commencee = 
    match ecart_connu j with
    | None -> false
    | Some _ -> true
  in
  let partie_terminee =
    j.plis_joues >= 15 || (j.plis_joues = 14 && pli_termine j)
  in
  let en_cours =
    match j.carte_a_jouer with
    | None -> false | _ -> true
  in
  let tapis_complet = List.length j.tapis >= 5 in
  not (en_cours)
  && not (partie_terminee)
  && partie_commencee
  && mon_numero j = Some (devant_jouer j)
  && not tapis_complet
let plus_gros_atout (est_atout: 'carte -> bool) 
    (valeur_of_carte: 'carte -> 'valeur) (j: 'carte partie) : 'valeur option =
  let max a b =
    if est_atout b then
      match a with 
      | Some a when a >= valeur_of_carte b -> Some a
      | _ -> Some (valeur_of_carte b)
    else a
  in
  List.fold_left
    (max)
    None
    j.tapis
let cartes_jouables est_atout valeur_of_carte couleur_of_carte
		    excuse j =
  if doit_jouer j then (*on est en jeu*)
    (* 1er cas : couleur appelée *)
    let couleur_interdite =
      match couleur_demandee (couleur_of_carte) excuse j with
      | None when j.plis_joues = 0 -> 
	 (* On n'a pas le droit de mettre la couleur appelée, sauf le roi*)
	 true
      | _ -> false
    in
    let atouts_au_tapis = 
      List.fold_right
	(@)
	(List.map (fun c -> if est_atout c then [valeur_of_carte c]
			    else []) j.tapis)
	[]
    in
    let mes_atouts = 
      List.fold_right
	(@)
	(List.map (fun c -> if est_atout c then [valeur_of_carte c]
			    else []) j.mon_jeu)
	[]in
    let atout_superieur acc v =
      match acc with
      | None -> Some v
      | Some x when x > v -> Some x
      | _ -> Some v
    in
    let pgo = List.fold_left (atout_superieur) None atouts_au_tapis in
    let mon_pgo = List.fold_left (atout_superieur) None mes_atouts in
    (* plus gros atout *)
    let couleur_demandee = couleur_demandee (couleur_of_carte)
					     excuse j in
    let plus_de_couleur_demandee =
      match couleur_demandee with
      | Some x -> 
	 not (List.exists (fun c -> (couleur_of_carte c) = x)
			  j.mon_jeu)
      | None -> false
    in
    let plus_d_atout =
      not (List.exists (est_atout) j.mon_jeu)
    in
    let examiner carte =
      let est_de_couleur_interdite =
	if couleur_interdite then
	  match couleur_demandee with
	  | Some x -> x = couleur_of_carte carte
	  | _ -> false
	else false
      in
      let est_carte_appelee =
	match carte_appelee j with
	| None -> false
	| Some x -> x = carte
      in
      if not est_carte_appelee && est_de_couleur_interdite then false
      else 
	let est_de_couleur_demandee =
	  match couleur_demandee with
	  | None -> true (* par défaut... *)
	  | Some x -> x = couleur_of_carte carte
		      || carte = excuse
	in
	let coupe = est_atout carte in
	let fournit_a_atout = est_de_couleur_demandee && coupe in
	let surcoupe = 
	  match pgo with
	  | None -> true
	  | Some pgo -> valeur_of_carte carte > pgo 
	in
	if fournit_a_atout then
	  surcoupe || mon_pgo < pgo (* J'ai alors le droit de sous-couper *)
	else if est_de_couleur_demandee then true (* dont l'excuse *)
	else if coupe then
	  (* Je dois vérifier que je n'ai plus de la couleur demandee *)
	  (* et que je surcoupe ou que j'ai une bonne raison de *)
	  (* sous-couper*)
	  (surcoupe || mon_pgo < pgo)
	  && plus_de_couleur_demandee
	else (* Je pisse *)
	  (* Je dois vérifier que je n'ai plus de la couleur demandée *)
	  (* et plus d'atout *)
	  plus_de_couleur_demandee && plus_d_atout
    in
    List.filter (examiner) j.mon_jeu
  else 
    []
let make () =
  {
    joueur = Joueur.make ();
    mon_jeu = [];
    chien = [];
    tapis = [];
    joueur_ouverture = 0;
    plis_joues = 0;
    carte_a_jouer = None;
    chaine_reponse = [];
  }
let rec ajouter_une_carte int_of_carte liste carte =
  match liste with
  | a :: b when int_of_carte a < int_of_carte carte -> 
     a :: (ajouter_une_carte (int_of_carte) b carte)
  | reste -> carte :: reste

let traiter_reponse joueur f =
  if Joueur.requete_en_cours joueur.joueur then
    Joueur.traiter_reponse
      joueur.joueur
      (function Joueur.Accepte -> f Accepte
	      | Joueur.Refuse -> f Refuse
	      | Joueur.Erreur -> f Erreur)
  else if requete_en_cours joueur then
    joueur.chaine_reponse <- (f) :: joueur.chaine_reponse
  else raise Pas_de_requete
let repondre_aux joueur rep =
  if Joueur.requete_en_cours joueur.joueur then
    Joueur.repondre_aux
      joueur.joueur
      begin match rep with
	    | Accepte -> Joueur.Accepte
	    | Refuse -> Joueur.Refuse
	    | Erreur -> Joueur.Erreur end
  else
    begin
      List.iter (fun f -> f rep)
		(List.rev joueur.chaine_reponse);
      joueur.chaine_reponse <- [];
      joueur.carte_a_jouer <- None;
    end
let requete_refuse joueur =
  repondre_aux joueur Refuse   
let requete_acceptee joueur =
  repondre_aux joueur Accepte
let assimiler_requete_deconnecter joueur =
  Joueur.assimiler_requete_deconnecter joueur.joueur;
  repondre_aux joueur Erreur
let assimiler_requete_identifier joueur nom =
  if requete_en_cours joueur then
    raise Requete_en_cours
  else
    Joueur.assimiler_requete_identifier joueur.joueur nom
let assimiler_requete_inviter joueur noms =
  if requete_en_cours joueur then
    raise Requete_en_cours
  else
    let () = Joueur.assimiler_requete_inviter joueur.joueur noms in
    ()
let assimiler_requete_prise joueur prise =
  if requete_en_cours joueur then
    raise Requete_en_cours
  else
    Joueur.assimiler_requete_prise joueur.joueur prise
let assimiler_requete_appel joueur carte =
  if requete_en_cours joueur then
    raise Requete_en_cours
  else 
    Joueur.assimiler_requete_appel joueur.joueur carte
let assimiler_requete_ecart joueur cartes =
  if requete_en_cours joueur then
    raise Requete_en_cours
  else
    Joueur.assimiler_requete_ecart joueur.joueur cartes
let assimiler_requete_carte joueur c =
  if requete_en_cours joueur then
    raise Requete_en_cours
  else 
    joueur.carte_a_jouer <- Some c

let assimiler_information_erreur joueur =
  repondre_aux joueur Refuse
let assimiler_information_connexion joueur =
  Joueur.assimiler_information_connexion joueur.joueur
let assimiler_information_deconnexion joueur =
  Joueur.assimiler_information_deconnexion joueur.joueur;
  repondre_aux joueur Erreur
let assimiler_information_entree joueur =
  Joueur.assimiler_information_entree joueur.joueur
let assimiler_information_sortie joueur =
  Joueur.assimiler_information_sortie joueur.joueur
let assimiler_information_noms joueur noms =
  Joueur.assimiler_information_noms joueur.joueur noms;
  joueur.mon_jeu <- [] ;
  joueur.chien <- [] ;
  joueur.tapis <- [] ;
  joueur.joueur_ouverture <- 0 ;
  joueur.plis_joues <- 0
let assimiler_information_numero joueur n =
  Joueur.assimiler_information_numero joueur.joueur n
let assimiler_information_contrat joueur x =
  Joueur.assimiler_information_contrat joueur.joueur x
let assimiler_information_appel joueur =
  Joueur.assimiler_information_appel joueur.joueur
let assimiler_information_contrat_final string_of_carte
					joueur preneur contrat appel =
  Joueur.assimiler_information_contrat_final (string_of_carte) 
					     joueur.joueur preneur
					     contrat appel
let assimiler_information_atout_au_chien joueur atouts =
  Joueur.assimiler_information_atout_au_chien joueur.joueur atouts
let enlever_carte joueur carte =
  joueur.mon_jeu <- 
    List.filter (fun c -> c <> carte) joueur.mon_jeu
let assimiler_information_jeu joueur =
  Joueur.assimiler_information_jeu joueur.joueur;
  (* Au cas où je serais le preneur, *)
  (* j'enlève les cartes de l'écart de mon jeu*)
  match ecart_connu joueur with
  | None -> failwith ("Ne peut arriver, je viens d'appeler"
		      ^" Joueur.assimiler_information_jeu")
  | Some liste ->
     List.iter (enlever_carte joueur) liste
let assimiler_information_distribution int_of_carte joueur mes_cartes =
  joueur.mon_jeu <- List.fold_left (ajouter_une_carte (int_of_carte)) [] mes_cartes
let assimiler_information_chien int_of_carte joueur chien =
  joueur.chien <- chien;
  if Joueur.mon_numero joueur.joueur 
     = Joueur.preneur joueur.joueur then
    (* let () = Printf.printf "Je prends les %d cartes du chien.\n%!" *)
    (* 			   (List.length chien) in *)
    joueur.mon_jeu <- 
      List.fold_left (ajouter_une_carte (int_of_carte)) joueur.mon_jeu chien
let assimiler_information_pli joueur j =
  (* let () = Printf.printf "Assimilation d'un pli (partie)...\n%!" in *)
  joueur.joueur_ouverture <- j;
  joueur.tapis <- [];
  joueur.plis_joues <- 1 + joueur.plis_joues;
  (* let () = Printf.printf "Pli assimilé (partie).\n%!" in *)
  ()
let assimiler_information_carte joueur c =
  let c_est_moi =
    match Joueur.mon_numero joueur.joueur with
    | None -> false
    | Some x -> 
       x mod 5 = devant_jouer joueur
       && match joueur.carte_a_jouer with
	  | None -> false
	  | Some c_demandee -> c_demandee = c
  in
  joueur.tapis <- c :: joueur.tapis;
  enlever_carte joueur c ;
  if c_est_moi then
    requete_acceptee joueur;
